home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Menus / filesetsMenu.tcl < prev    next >
Encoding:
Text File  |  1997-12-20  |  46.1 KB  |  1,625 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "filesetsMenu.tcl"
  6.  #                                      created: 20/7/96 {6:22:25 pm} 
  7.  #                                  last update: 20/12/97 {6:57:54 pm} 
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  #==============================================================================
  15.  # Alpha calls two fileset-related routines, 'getCurrFileSet', and 
  16.  # 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
  17.  # on occasion, but this isn't critical.
  18.  #==============================================================================
  19.  # 
  20.  #  modified by  rev reason
  21.  #  -------- --- --- -----------
  22.  #  24/3/96  VMD 1.0 update of Pete's original to allow mode-specific filesets
  23.  #  27/3/96  VMD 1.1 added hierarchial filesets, and checks for unique menus
  24.  #  13/6/96  VMD 1.2 memory efficiency improvements with 'fileSets' array
  25.  #  10/3/97  VMD 1.3 added 'procedural' fsets, including 'Open Windows'
  26.  #  6/4/97   VMD 1.31 various fixes incorporated - thanks!
  27.  #  11/7/97  VMD 1.4 added cache for the fileset menu, improved wc proc.
  28.  #  15/7/97  VMD 1.41 better handling of out-of-date filesets, and dir opening
  29.  #  15/7/97  VMD 1.42 placed cache in separate file.
  30.  #  21/7/97  VMD 1.43 added glob patterns to ignore for directory filesets
  31.  #  22/7/97  VMD 1.5 more sophisticated menu caching.  No more long rebuilds!
  32.  #  10/9/97  VMD 1.6 simplified some stuff for new Alpha-Tcl
  33.  #  7/12/97  VMD 1.6.1 makes use of winNumDirty flag
  34.  # ###################################################################
  35.  ##
  36.  
  37. ## 
  38.  # These procedures    are    now    more robust    and    general-purpose. Basic new
  39.  # features    are: 
  40.  # 
  41.  #       *  user configurable    menu
  42.  #       *  unique-menu names    are    ensured, so    there can be no    clashes
  43.  #       *  new fileset types    ('tex' and 'fromHierarchy')
  44.  #       *  new utility functions    ('stuff', 'wordCount',...)
  45.  #       *  filesets need    not    appear in the menu;    in fact    they can be
  46.  #          anywhere you like
  47.  #          
  48.  # Known Bugs:
  49.  # 
  50.  #  You cannot have a hierarchial fileset which contains more than
  51.  #  one folder with the same name as the fileset, including the
  52.  #  base folder.  This is very hard to fix, and the easy workaround
  53.  #  is just to rename the fileset in some minor way.
  54.  ##
  55.  
  56. alpha::menu filesetMenu 1.6.1 "•131" in_menu {
  57. } uninstall {this-file} help {[editMark "$HOME:Help:Alpha Manual" "File Sets" -r]}
  58.  
  59. proc filesetMenu {} {}
  60.  
  61. # Build some filesets on the fly.
  62. set gfileSets(Help) "$HOME:Help:*"
  63. set gfileSets(System) [list "$HOME:Tcl:SystemCode:*.tcl" 2]
  64. set gfileSets(Menus) "$HOME:Tcl:Menus:*.tcl"
  65. set gfileSets(Modes) [list "$HOME:Tcl:Modes:*.tcl" 2]
  66. set "gfileSets(Open Windows)" procFilesetOpenWindows 
  67. set "gfileSets(Top Window Folder)" procFilesetDirTopWin 
  68.  
  69. # Declare their types
  70. set gfileSetsType(Help) "fromDirectory"
  71. set gfileSetsType(System) "fromHierarchy"
  72. set gfileSetsType(Modes) "fromHierarchy"
  73. set gfileSetsType(Menus) "fromDirectory"
  74. set "gfileSetsType(Open Windows)" "procedural"
  75. set "gfileSetsType(Top Window Folder)" "procedural"
  76.  
  77. # Procs for procedural filesets
  78. proc procFilesetOpenWindows {} { return [winNames -f] }
  79. proc procFilesetDirTopWin {} { 
  80.     return [glob -t TEXT -nocomplain "[file dirname [win::Current]]:*"]
  81. }
  82.  
  83. if {![file exists "$HOME:Tcl:Packages"]} { mkdir "$HOME:Tcl:Packages" }
  84. set gfileSets(Packages) [list "$HOME:Tcl:Packages:*.tcl" 2]
  85. set gfileSetsType(Packages) "fromHierarchy"
  86.  
  87. # Default curr fileset is the first one. 
  88. newPref var currFileSet "SystemCode" global changeFileSet gfileSets array
  89.  
  90. #################################################
  91. #                                                #
  92. #    Section    1:    Fileset    variables and flags.    #
  93. #                                                #
  94. #################################################
  95. # Any of these can be over-ridden by the stored #
  96. # definitions in defs.tcl, arrdefs.tcl          #
  97. #################################################
  98.  
  99. ## 
  100.  # We don't    show the 'help'    fileset, since it's    under the MacOS
  101.  # AppleGuide menu.     Also we could perhaps yank    tex-filesets away
  102.  # into    their own menu,    in which case the tex-system could add to
  103.  # this    variable as    it went    along.
  104.  ##
  105. lunion filesetsNotInMenu "Help" "Open Windows" "Top Window Folder"
  106.  
  107. ## 
  108.  # A type is a means of    generating a fileset given its 
  109.  # description in the variable 'gfileSets(name)':
  110.  ##
  111. lunion fileSetsTypes "list" "glob" "fromHierarchy" "procedural"
  112.  
  113. ## 
  114.  # A menu type is a    means of prompting the user    and    
  115.  # characterising the interface    to a type, even
  116.  # though the actual storage may be    very simple
  117.  # (a list in most cases).
  118.  ##
  119. set fileSetsTypesThing(fromDirectory) "glob"
  120. set fileSetsTypesThing(fromHierarchy) "fromHierarchy"
  121. set fileSetsTypesThing(think) "list"
  122. set fileSetsTypesThing(codewarrior) "list"
  123. set fileSetsTypesThing(ftp) "list"
  124. set fileSetsTypesThing(fromOpenWindows) "list"
  125. set fileSetsTypesThing(procedural) "procedural"
  126.  
  127. ## 
  128.  # To add a    new    fileset    type, you need to define the following:
  129.  #       set fileSetsTypesThing(myType) "list"
  130.  #       proc    myTypeCreateFileset    {} {}
  131.  #       proc    myTypeFilesetUpdate    {name} {}
  132.  # 
  133.  # For more    complex    types (e.g.    the    tex-type), define as follows:
  134.  #       set fileSetsTypesThing(myType) "myType"
  135.  #       proc    myTypeCreateFileset    {} {}
  136.  #       proc    myTypeFilesetSelected {    fset menu item }    {}
  137.  #       proc    myTypeFilesetUpdate    { name } {}
  138.  #       proc    myTypeListFilesInFileset { name    } {}
  139.  #       proc    myTypeMakeFileSetSubMenu { name    } {}
  140.  # 
  141.  # These procedures    will all be    called automatically under the
  142.  # correct circumstances.  The purposes of these are as follows:
  143.  #
  144.  #   'create'   -- query the user for name etc. and create
  145.  #   'update'   -- given the information in 'gfileSets', recalculate
  146.  #                   the member files.
  147.  #   'selected' -- a member was selected in a menu.
  148.  #   'list'     -- given info in all except 'fileSets', return list
  149.  #                 of files to be stored in that variable.
  150.  #   'submenu'  -- generate the sub-menu
  151.  # 
  152.  # Your    code may wish to call 'isWindowInFileset ?win? ?type?' to
  153.  # check if    a given    (current by    default) window    is in a    fileset    of
  154.  # a given type.
  155.  ##
  156.  
  157. ## 
  158.  # -------------------------------------------------------------------------
  159.  #     
  160.  #    "filesetSortOrder" --
  161.  #    
  162.  #       The structure of    this variable dictates how the fileset
  163.  #       menu    is structured:
  164.  #           
  165.  #           '{pattern p}' 
  166.  #               lists all filesets which    match 'p'
  167.  #           '-' 
  168.  #               adds    a separator    line
  169.  #           '{list of types}' 
  170.  #               lists all filesets of those types.
  171.  #           '{submenu name sub-order-list}' 
  172.  #               adds    a submenu with name    'name' and recursively
  173.  #               adds    filesets to    that submenu as    given by the 
  174.  #               sub-order.
  175.  #               
  176.  #       Leading,    trailing and double    separators are automatically
  177.  #       removed.
  178.  #     
  179.  # -------------------------------------------------------------------------
  180.  ##
  181. ensureset filesetSortOrder { {pattern *System} {pattern Packages} \
  182.     {pattern Menus} {pattern Modes} {pattern Preferences} \
  183.     - {tex} - {pattern *.cc} {submenu Headers {pattern *.h}} \
  184.     - {fromDirectory think codewarrior ftp \
  185.     fromOpenWindows fromHierarchy} * } 
  186.  
  187. set    "filesetUtils(browseFileset…)" [list * browseFileset]
  188. set    "filesetUtils(renameFileset…)" [list * renameFileset]
  189. set    "filesetUtils(openEntireFileset…)" [list * openEntireFileset]
  190. set    "filesetUtils(filesetToAlpha…)" [list * filesetToAlpha]
  191. set    "filesetUtils(closeEntireFileset…)" [list * closeEntireFileset]
  192. set    "filesetUtils(replaceInFileset…)" [list * replaceInFileset]
  193. set    "filesetUtils(stuffFileset…)" [list * stuffFileset]
  194. set    "filesetUtils(wordCount)" [list * wordCountFileset]
  195. set    "filesetUtils(wordCountFast)" [list * wordCountFilesetFast]
  196. set    "filesetUtils(openFilesetFolder…)" [list * openFilesetFolder]
  197.  
  198.  
  199. ## 
  200.  # The meaning of these    flags is as    follows:
  201.  #       sortFilesetItems    -- 
  202.  #           a type can have the option of being unsorted    (e.g. tex-filesets)
  203.  #       indentFilesetItems --
  204.  #           visual formatting may be    of relevance to    some types
  205.  #       sortFilesetsByType -- 
  206.  #           use the variable    'filesetSortOrder' to determine    the
  207.  #           visual structure    of the fileset menu
  208.  #       autoAdjustFileset --
  209.  #           when    a file is selected from    the    menu, do we    try    and    
  210.  #           keep    'currFileSet' accurate?
  211.  #       includeNonTextFiles --
  212.  #           filesets may include non-text files.  Alpha will tell the
  213.  #           finder to open these if they are selected.
  214.  ##        
  215. newPref flag sortFilesetItems 0 "fileset"
  216. newPref flag indentFilesetItems 0 "fileset"
  217. newPref flag sortFilesetsByType 0 "fileset" rebuildSomeFilesetMenu
  218. newPref flag autoAdjustFileset 0 "fileset"
  219. newPref flag includeNonTextFiles 0 "fileset" rebuildSomeFilesetMenu
  220.  
  221. # To add a new fileset type, all we have to do is this:
  222. # set fileSetsTypesThing(tex) "tex"
  223. # lappend fileSetsTypes "tex"
  224. # If you create new types just add lines like that
  225.  
  226. #===========================================================================
  227. # The support routines.
  228. #===========================================================================
  229. # Called from Alpha to get list of files for current file set.
  230. proc getCurrFileSet {} {
  231.     global currFileSet
  232.     return [getFileSet $currFileSet]
  233. }
  234.  
  235. # Called from Alpha to get names. The first name returned is taken to 
  236. # be the current fileset.
  237. proc getFileSetNames {} {
  238.     global gfileSets currFileSet gDirScan
  239.     set perm [list $currFileSet]
  240.     set temp {}
  241.     set ind [lsearch [array names gfileSets] $currFileSet]
  242.     if {$ind < 0} {set ind 0}
  243.     foreach n [lsort -ignore [array names gfileSets]] {
  244.         if {[info exists gDirScan($n)]} {
  245.             lappend temp $n
  246.         } else {
  247.             lappend perm $n
  248.         }
  249.     }
  250.     if {$temp != {}} {
  251.         return [concat $perm - $temp]
  252.     } else {
  253.         return $perm
  254.     }
  255. }
  256.  
  257. #================================================================================
  258. # Edit a file from a fileset via list dialogs (no mousing around).
  259. #================================================================================
  260. proc editFile {} {
  261.     global currFileSet modifiedVars gfileSetsType
  262.     
  263.     set fset [pickFileset "" {Fileset?} "list" [list {*recent*}]]
  264.     set currFileSet $fset
  265.     lappend modifiedVars currFileSet
  266.     
  267.     if {$fset == {*recent*}} {return [editRecentFile]}
  268.     set ff [getFilesInSet $fset]
  269.     foreach f $ff {
  270.         lappend disp [file tail $f]
  271.     }
  272.     foreach res [listpick -l -p {File?} [lsort -ignore $disp]]  {
  273.         set ind [lsearch $ff \*:$res]
  274.         if {$gfileSetsType($fset) == "ftp"} {
  275.             ftpFilesetOpen $fset [lindex $ff $ind]
  276.         } else {
  277.             catch {generalOpenFileitem [lindex $ff $ind]}
  278.         }
  279.     }
  280. }
  281.  
  282. # We only return TEXT files, since we don't want Alpha
  283. # manipulating the data fork of non-text files.
  284. proc getFileSet {fset} {
  285.     global filesetmodeVars
  286.     if $filesetmodeVars(includeNonTextFiles) {
  287.         set fnames ""
  288.         foreach f [getFilesInSet $fset] {
  289.             if [file isfile $f] {
  290.                 getFileInfo $f a
  291.                 if {$a(type) == "TEXT"} {
  292.                     lappend fnames $f
  293.                 }
  294.             }
  295.         }
  296.         return $fnames
  297.     } else {
  298.         return [getFilesInSet $fset]
  299.     }
  300. }
  301.  
  302. proc browseFileset {{fset ""}} {
  303.     global tileLeft tileTop tileWidth errorHeight
  304.  
  305.     set fset [pickFileset $fset {Fileset?}]
  306.  
  307.     foreach f [getFilesInSet $fset] {
  308.         append text "\t[file tail $f]\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  309.     }
  310.     new -n "* FileSet '$fset' Browser *" -g $tileLeft $tileTop 200 $errorHeight -m Brws
  311.     insertText "(<cr> to go to file)\r-----\r$text\r"
  312.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  313.     winReadOnly
  314.     message ""
  315. }    
  316.  
  317. ############################################
  318. #                                           #
  319. #    Section    2:    Basic fileset procedures   #
  320. #                                           #
  321. ############################################
  322.  
  323. proc newFileset {} {
  324.     global currFileSet gfileSetsType fileSetsTypesThing modifiedArrayElements
  325.     set type [dialog::optionMenu "New fileset type?"  [lsort -ignore [array names fileSetsTypesThing]] "fromDirectory"]
  326.     set name [eval ${type}CreateFileset]
  327.  
  328.     if ![string length $name] return
  329.     
  330.     lappend modifiedArrayElements [list $name gfileSetsType]
  331.     set gfileSetsType($name) $type
  332.  
  333.     set currFileSet $name
  334.     filesetsJustChanged $type $name
  335.     return $currFileSet
  336. }
  337.  
  338. ## 
  339.  # -------------------------------------------------------------------------
  340.  # 
  341.  # "filesetsJustChanged" --
  342.  # 
  343.  #  If we've added, deleted, modified a fileset, we call this procedure.
  344.  #  In most cases we must rebuild everything (due to limitations in Alpha),
  345.  #  but for 'procedural' filesets, we can just do the utilities menu.
  346.  # -------------------------------------------------------------------------
  347.  ##
  348. proc filesetsJustChanged {type name} {
  349.     if {$type == "procedural"} {
  350.         global filesetsNotInMenu modifiedVars
  351.         if {[lsearch $filesetsNotInMenu $name] == -1} {
  352.             lappend filesetsNotInMenu $name
  353.             lappend modifiedVars filesetsNotInMenu
  354.         }
  355.         rebuildFilesetUtilsMenu
  356.     } else {
  357.         rebuildAllFilesets 1
  358.     }
  359. }
  360.  
  361. proc deleteFileset { {fset ""} {yes 0} } {
  362.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  363.     global filesetMenu subMenuFilesetInfo subMenuInfo filesetsNotInMenu
  364.     global modifiedVars modifiedArrayElements
  365.     
  366.     set fset [pickFileset $fset "Delete which Fileset?"]
  367.      if {$currFileSet == $fset} {catch {set currFileSet System}}
  368.  
  369.     if {$yes || [dialog::yesno "Delete fileset \"$fset\"?"]} {
  370.         catch {unset "fileSetsExtra($fset)"}
  371.         catch {unset "gfileSetsType($fset)"}
  372.         catch {unset "fileSets($fset)"}
  373.         catch {unset "gfileSets($fset)"}
  374.         
  375.         lappend modifiedArrayElements \
  376.           [list $fset gfileSetsType] [list $fset fileSetsExtra] \
  377.           [list $fset gfileSets]
  378.  
  379.         set err [catch {removeFilesetFromMenu $fset}]
  380.         
  381.         if {[set l [lsearch  $filesetsNotInMenu $fset]] != -1} {
  382.             set filesetsNotInMenu [lreplace $filesetsNotInMenu $l $l]
  383.             lappend modifiedVars filesetsNotInMenu
  384.             deleteMenuItem -m choose $fset
  385.             deleteMenuItem -m hideFileset $fset
  386.             return
  387.         }
  388.         if $err {
  389.             # it's on a submenu or somewhere else so we just have
  390.             # to do the lot!
  391.             if !$yes { rebuildAllFilesets 1 }
  392.         } else {
  393.             deleteMenuItem -m choose $fset
  394.             deleteMenuItem -m hideFileset $fset
  395.         }
  396.     }
  397. }
  398.  
  399. proc removeFilesetFromMenu {fset} {
  400.     global subMenuFilesetInfo subMenuInfo
  401.     # find its menu:
  402.     if [info exists subMenuFilesetInfo($fset)] {
  403.         foreach m $subMenuFilesetInfo($fset) {
  404.             # remove info about it's name
  405.             if [info exists subMenuInfo($m)] {
  406.                 unset subMenuInfo($m)
  407.                 cache::add filesetMenuCache "eval" [list unset subMenuInfo($m)]
  408.             }
  409.         }
  410.         set base [lindex $subMenuFilesetInfo($fset) 0]
  411.         unset subMenuFilesetInfo($fset)
  412.         cache::add filesetMenuCache "eval" [list unset subMenuFilesetInfo($fset)]
  413.         cache::snippetRemove $fset
  414.         # this will fail if it's on a submenu or if it isn't a menu at all
  415.         deleteMenuItem -m $filesetMenu $base
  416.         cache::add filesetMenuCache "eval" [list deleteMenuItem -m $filesetMenu $base]
  417.     } else {
  418.         # I think I do nothing
  419.     }
  420.     
  421. }
  422.  
  423. ## 
  424.  # -------------------------------------------------------------------------
  425.  #     
  426.  #    "pickFileset" --
  427.  #    
  428.  #     Ask the user for a/several    filesets.  If 'fset' is    set, we    just
  429.  #     return    that (this avoids 'if {$fset !=    ""}    { set fset [pick...] }
  430.  #     constructs    everywhere).  A    prompt can be given, and a dialog type
  431.  #     (either a listpick, a pop-up menu,    or a listpick with multiple
  432.  #     selection), and extra items can be    added to the list if desired.
  433.  # -------------------------------------------------------------------------
  434.  ##
  435. proc pickFileset { fset {prompt Fileset?} {type "list"} {extras {}} } {
  436.     global gfileSets currFileSet
  437.     if { $fset != "" } { return $fset }
  438.     switch $type {
  439.         "popup" {
  440.             set fset [eval [list prompt $prompt \
  441.                 $currFileSet "FileSet:"] [lsort -ignore [array names gfileSets]]]
  442.             if ![info exists gfileSets($fset)] { error "No such fileset" }
  443.             return $fset
  444.         }
  445.         "list" {
  446.             return [listpick -p $prompt -L $currFileSet \
  447.                 [lsort -ignore [concat $extras [array names gfileSets]]]]
  448.         }
  449.         "multilist" {
  450.             return [listpick -p $prompt -l -L $currFileSet \
  451.                 [lsort -ignore [concat $extras [array names gfileSets]]]]
  452.         }        
  453.     }
  454. }
  455.  
  456. proc renameFileset {} {
  457.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  458.     global fileSetsTypesThing modifiedArrayElements
  459.     
  460.     set fset [pickFileset "" {Fileset to rename?}]
  461.      
  462.     set name [getline "Rename to:" $fset]
  463.     if {![string length $name] || $name == $fset} return
  464.  
  465.     set gfileSets($name) $gfileSets($fset)
  466.     set gfileSetsType($name) $gfileSetsType($fset)
  467.     catch {set fileSets($name) $fileSets($fset)}
  468.     catch {set fileSetsExtra($name) $fileSetsExtra($fset)}
  469.  
  470.     deleteFileset $fset 1
  471.     
  472.     lappend modifiedArrayElements [list $name gfileSets]
  473.     lappend modifiedArrayElements [list $name gfileSetsType]
  474.     lappend modifiedArrayElements [list $name fileSetsExtra]
  475.     
  476.     filesetsJustChanged $gfileSetsType($name) $name
  477.     set currFileSet $name
  478. }
  479.  
  480. proc updateCurrentFileset {} {
  481.     global currFileSet
  482.     updateAFileset $currFileSet
  483. }
  484.  
  485. proc updateAFileset { {fset ""} } {
  486.     set fset [pickFileset $fset]
  487.     
  488.     global gfileSetsType fileSets subMenuFilesetInfo subMenuInfo
  489.     
  490.     set type $gfileSetsType($fset)
  491.     catch {eval [list "${type}FilesetUpdate" $fset] }
  492.     set m [makeFileSetAndMenu $fset 1]
  493.     # we could rebuild the menu with this: but we don't
  494.     cache::add filesetMenuCache "eval" $m
  495.     if {[info exists subMenuFilesetInfo($fset)]} {
  496.         # if the fileset already has a base menu, use that:
  497.         foreach n $subMenuFilesetInfo($fset) {
  498.             cache::add filesetMenuCache "variable" subMenuInfo($n)
  499.         }
  500.         cache::add filesetMenuCache "variable" subMenuFilesetInfo($n)
  501.     }
  502.     if [info exists fileSets($fset)] {
  503.         cache::add filesetMenuCache "variable" fileSets($fset)
  504.     }
  505.     eval $m
  506.     callFilesetUpdateProcedures $fset
  507.     message "Done"
  508. }
  509.  
  510. proc callFilesetUpdateProcedures { {fset ""} } {
  511.     global filesetUpdateProcs gfileSetsType
  512.     if { $fset == "" } {
  513.         set types [array names filesetUpdateProcs]
  514.     } else {
  515.         set types $gfileSetsType($fset)
  516.     }
  517.     
  518.     foreach l $types {
  519.         if [info exists filesetUpdateProcs($l)] {
  520.             foreach proc $filesetUpdateProcs($l) {
  521.                 eval $proc
  522.             }
  523.         }
  524.     }
  525.     
  526. }
  527.  
  528. ##################################################
  529. #                                                 #
  530. #    Section    3: Creation    of basic fileset types     #
  531. #                                                 #
  532. ##################################################
  533.  
  534. proc proceduralCreateFileset {} {
  535.     global gfileSets gfileSetsType filesetsNotInMenu modifiedArrayElements
  536.     set name [getline "Name for this fileset…"]
  537.     if {![string length $name]} return
  538.     set gfileSetsType($name) "procedural"
  539.     set p procFileset[join $name ""]
  540.     set gfileSets($name) $p
  541.     addUserLine "\# procedure to list files in fileset '$name' on the fly"
  542.     addUserLine "proc $p \{\} \{"
  543.     addUserLine "\t"
  544.     addUserLine "\}"
  545.     lappend modifiedArrayElements [list $name gfileSets]
  546.     lappend modifiedArrayElements [list $name gfileSetsType]
  547.     if {[dialog::yesno "I've added a template for the procedure to your 'prefs.tcl'. Do you want to edit it now?"]} {
  548.         global::editPrefsFile
  549.         goto [maxPos]
  550.         beep
  551.         message "Make sure you 'load' the new procedure."
  552.     }
  553.     lappend filesetsNotInMenu $name
  554.     return $name
  555. }
  556.  
  557. proc fromDirectoryCreateFileset {} {
  558.     global gfileSets gfileSetsType fileSetsExtra
  559.     
  560.     set name [getFilesetDirectoryAndPattern]
  561.     if ![string length $name] return
  562.     set filePatIgnore [getline "List of file patterns to ignore:" ""]
  563.     if {$filePatIgnore != ""} {
  564.         set fileSetsExtra($name) $filePatIgnore
  565.     }
  566.     
  567.     set gfileSetsType($name) "fromDirectory"
  568.     
  569.     if {[dialog::yesno "Save new fileset?"]} {
  570.         global modifiedArrayElements
  571.         lappend modifiedArrayElements [list $name gfileSets]
  572.         lappend modifiedArrayElements [list $name gfileSetsType]
  573.         if [info exists fileSetsExtra($name)] {
  574.             lappend modifiedArrayElements [list $name fileSetsExtra]
  575.         }
  576.     }
  577.     return $name
  578. }
  579.  
  580. proc getFilesetDirectoryAndPattern {} {
  581.     global gfileSets fileSetsExtra
  582.     set name [getline "New fileset name:" ""]
  583.     if {![string length $name]} return
  584.     
  585.     set dir [string trim [get_directory -p "New fileset dir:"] ":"]
  586.     if {![string length $dir]} return
  587.     
  588.     set filePat [getline "File pattern:" "*"]
  589.     if {![string length $filePat]} return
  590.     
  591.     set gfileSets($name) "$dir:$filePat"
  592.     return $name
  593. }
  594.  
  595. proc fromDirectoryFilesetUpdate {name} {
  596.     # done on the fly so no need to update
  597.     #global fileSets gfileSets
  598.     #set fileSets($name) [glob -nocomplain -t TEXT "$gfileSets($name)"]
  599. }
  600.  
  601. proc fromHierarchyCreateFileset {} {
  602.     global gfileSets gfileSetsType    
  603.     
  604.     set name [getFilesetDirectoryAndPattern]
  605.     if ![string length $name] return
  606.     
  607.     set gfileSetsType($name) "fromHierarchy"
  608.     set depth [listpick -p "Depth of hierarchy?" -L 3 {1 2 3 4 5 6 7}]
  609.     if { $depth == "" } {set depth 3}
  610.     
  611.     set gfileSets($name) [list $gfileSets($name) $depth]
  612.     
  613.     if {[dialog::yesno "Save new fileset?"]} {
  614.         global modifiedArrayElements
  615.         lappend modifiedArrayElements [list $name gfileSets]
  616.         lappend modifiedArrayElements [list $name gfileSetsType]
  617.     }
  618.     return $name
  619. }
  620.  
  621. proc fromHierarchyFilesetUpdate {name} {
  622.     global fileSets gfileSets
  623.     set fileSets($name) [fromHierarchyListFilesInFileSet $name]
  624. }
  625.  
  626. proc fromHierarchyMakeFileSetAndMenu {name andMenu} {
  627.     global filesetTemp fileSets gfileSets
  628.     set dir [file dirname [lindex $gfileSets($name) 0]]
  629.     set patt [file tail [lindex $gfileSets($name) 0]]
  630.     set depth [lindex $gfileSets($name) 1]
  631.     # we make the menu as a string, but can bin it if we like
  632.     set menu [buildSubMenu [list $dir] $name filesetProc filesetTemp $patt $depth $name]
  633.     
  634.     # we need to construct the list of items
  635.     set fileSets($name) {}
  636.     if [info exists filesetTemp] {
  637.         foreach n [array names filesetTemp] {
  638.             lappend fileSets($name) $filesetTemp($n)
  639.         }
  640.         unset filesetTemp
  641.     }
  642.     return $menu
  643. }
  644.  
  645. proc fromHierarchyFilesetSelected {fset menu item} {
  646.     global gfileSets
  647.     set dir [file dirname [lindex $gfileSets($fset) 0]]
  648.     set ff [getFilesInSet $fset]
  649.     if { $fset == $menu } {
  650.         # it's top level
  651.         if {[set match [lsearch $ff ${dir}:$item]] >= 0} {
  652.             autoUpdateFileset $fset
  653.             generalOpenFileitem [lindex $ff $match]
  654.             return
  655.         }
  656.     }
  657.     # the following two are slightly cumbersome, but give us the best
  658.     # chance of finding the correct file given any ambiguity (which can
  659.     # certainly arise if file and directory names clash excessively).
  660.     if {[set match [lsearch $ff ${dir}:${menu}:$item]] >= 0} {
  661.         autoUpdateFileset $fset
  662.         generalOpenFileitem [lindex $ff $match]
  663.         return
  664.     }
  665.     if {[set match [lsearch $ff ${dir}:*:${menu}:$item]] >= 0} {
  666.         autoUpdateFileset $fset
  667.         generalOpenFileitem [lindex $ff $match]
  668.         return
  669.     }
  670.     error "Weird! Couldn't find it."
  671. }
  672.  
  673.  
  674. proc codewarriorCreateTagFile {} { return [alphaCreateTagFile] }
  675. proc thinkCreateTagFile {} { return [alphaCreateTagFile] }
  676. proc codewarriorCreateFileset {} { return [createWarriorFileset] }
  677. proc thinkCreateFileset {} { return [createThinkFileset] }
  678.  
  679. proc fromOpenWindowsCreateFileset {} {
  680.     global gfileSets modifiedArrayElements
  681.     
  682.     set name [prompt "Create fileset containing current windows under what name?" "OpenWins"]
  683.  
  684.     set gfileSets($name) [winNames -f]
  685.     lappend modifiedArrayElements [list $name gfileSets]
  686.  
  687.     return $name
  688. }
  689.  
  690. ##################################
  691. #                                 #
  692. #    Section    4: Menu    Procedures     #
  693. #                                 #
  694. ##################################
  695.  
  696. ## 
  697.  # Global procedures to    deal with the fact that    Alpha can only have    one
  698.  # menu    with each given    name.  This    is only    a problem in dealing with
  699.  # user-defined    menus such as fileset menus, tex-package menus,    ...
  700.  ##
  701.  
  702. ## 
  703.  # -------------------------------------------------------------------------
  704.  #     
  705.  #    "makeFilesetSubMenu" --
  706.  #    
  707.  #     If    desired    this is    the    only procedure you need    use    ---    it returns
  708.  #     a menu    creation string, taking    account    of the unique name requirement
  709.  #     and will make sure    your procedure 'proc' is called    with the real
  710.  #     menu name!
  711.  # -------------------------------------------------------------------------
  712.  ##
  713. proc makeFilesetSubMenu {fset name proc args} {
  714.     if { [string length $proc] > 1 } {
  715.         return [concat {menu -m -n} [list [registerFilesetMenuName $fset $name $proc]] -p subMenuProc $args]
  716.     } else {
  717.         return [concat {menu -m -n} [list [registerFilesetMenuName $fset $name]] $args]
  718.     }
  719. }
  720.  
  721. ## 
  722.  # -------------------------------------------------------------------------
  723.  #     
  724.  #    "registerFilesetMenuName" --
  725.  #    
  726.  #     Call to ensure    unique fileset submenu names.  We just add spaces
  727.  #     as    appropriate    and    keep track of everything for you!  Filesets
  728.  #     which have    multiple menus _must_ register the main    menu first.
  729.  # -------------------------------------------------------------------------
  730.  ##
  731. proc registerFilesetMenuName {fset name {proc ""}} {
  732.     global subMenuInfo subMenuFilesetInfo
  733.     if { $fset == $name && [info exists subMenuFilesetInfo($fset)] } {
  734.         # if the fileset already has a base menu, use that:
  735.         foreach n $subMenuFilesetInfo($fset) {
  736.             if { [string trimright $n] == $fset } {
  737.                 set base $n
  738.             } 
  739.             unset subMenuInfo($n)
  740.         }
  741.         unset subMenuFilesetInfo($fset)
  742.     }
  743.     set original $name                    
  744.     if [info exists base] {
  745.         set name $base
  746.     } else {
  747.         # I add at least one space to _all_ hierarchical submenus now.
  748.         # This is so I won't clash with any current or future modes
  749.         # which should never normally add spaces themselves.
  750.         append name " "
  751.         while { [info exists subMenuInfo($name)] } {
  752.             append name " "
  753.         }        
  754.     }
  755.     
  756.     set subMenuInfo($name) [list "$fset" "$original" "$proc"]
  757.     # build list of a fileset's menus
  758.     lappend subMenuFilesetInfo($fset) "$name"
  759.     
  760.     return $name
  761. }
  762.  
  763.  
  764. proc realMenuName {name} {
  765.     global subMenuInfo
  766.     return [lindex $subMenuInfo($name) 1]
  767. }
  768.  
  769. ## 
  770.  # -------------------------------------------------------------------------
  771.  #     
  772.  #    "subMenuProc" --
  773.  #    
  774.  #     This procedure    is implicitly used to deal with    ensuring unique
  775.  #     sub-menu names.  It calls the procedure you asked for,    with
  776.  #     the name of the menu you think    you're using.
  777.  # -------------------------------------------------------------------------
  778.  ##
  779. proc subMenuProc {menu item} {
  780.     global subMenuInfo
  781.     set l $subMenuInfo($menu)
  782.     set realProc [lindex $l 2]
  783.     if {[info commands $realProc] == ""} {catch "$realProc"}
  784.     # try to call the proc with three arguments (fileset is 1st)
  785.     if {[llength [info args $realProc]] == 2} {
  786.         $realProc [lindex $l 1] "$item"
  787.     } else {
  788.         $realProc [lindex $l 0] [lindex $l 1] "$item"
  789.     }
  790. }
  791.  
  792.  
  793. proc filesetMenuProc {menu item} {
  794.     switch $item {
  795.         "Edit File" {
  796.             editFile
  797.             return
  798.         } 
  799.         "Help" {
  800.             global HOME
  801.             editMark "$HOME:Help:Alpha Manual" "File Sets" -r
  802.             return
  803.         }
  804.     }
  805. }
  806.  
  807. ## 
  808.  # -------------------------------------------------------------------------
  809.  #     
  810.  #    "filesetProc" --
  811.  #    
  812.  #     Must be called    by 'subMenuProc'
  813.  # -------------------------------------------------------------------------
  814.  ##
  815. proc filesetProc {fset menu item} {
  816.     global gfileSetsType 
  817.     if {$fset != ""} {set m $fset} else { set m $menu}
  818.     switch $gfileSetsType($m) {
  819.         "fromDirectory" -
  820.         "think" -
  821.         "codewarrior" -
  822.         "fromOpenWindows" {
  823.             if [catch {filesetBasicOpen $m $item}] {
  824.                 if {[dialog::yesno "That file wasn't found.  That fileset is probably out of date; do you want to rebuild it?"]} {
  825.                     updateAFileset $fset
  826.                 }
  827.             }
  828.         }
  829.         "ftp" { ftpFilesetOpen $m $item }
  830.         "default" {
  831.             # try a type-specific method first
  832.             set proc $gfileSetsType($m)FilesetSelected
  833.             if {[info commands $proc] == ""} {
  834.                 # auto-load it
  835.                 catch $proc
  836.             }
  837.             if {[info commands $proc] != ""} {                
  838.                 if {[llength [info args $proc]] == 2} {
  839.                     if ![catch {eval [list $proc $menu $item]}] {return}
  840.                 } else {
  841.                     if ![catch {eval [list $proc $fset $menu $item]}] {return}
  842.                 }
  843.             } else {
  844.                 # if that failed then just hope it's an ordinary list
  845.                 if ![catch {filesetBasicOpen $m $item}] {return}
  846.             }
  847.             
  848.             if {[dialog::yesno "That file wasn't found.  That fileset is probably out of date; do you want to rebuild it?"]} {
  849.                 updateAFileset $fset
  850.             }
  851.         }
  852.     }
  853. }
  854.  
  855. proc filesetBasicOpen { menu item } {
  856.     if {[set match [lsearch [getFilesInSet $menu] *:$item]] >= 0} {
  857.         autoUpdateFileset $menu
  858.         generalOpenFileitem [lindex [getFilesInSet $menu] $match]
  859.         return
  860.     }
  861.     error "file not found"
  862. }
  863.  
  864. ## 
  865.  # -------------------------------------------------------------------------
  866.  # 
  867.  # "generalOpenFileitem" --
  868.  # 
  869.  #  Works around an alpha bug with aliases.
  870.  # -------------------------------------------------------------------------
  871.  ##
  872. proc generalOpenFileitem {file} {
  873.     if [file isfile $file] {
  874.         file::openAny $file
  875.     } else {
  876.         # is it an alias?
  877.         if {[file type $file] == "unknown"} {
  878.             getFileInfo $file a
  879.             # is it a folder?
  880.             if {$a(type) != "fdrp"} {
  881.                 file::openAny $file
  882.             }
  883.         }
  884.         findFile "${file}:"
  885.     }
  886. }
  887.  
  888. proc registerUpdateProcedure { type proc } {
  889.     global filesetUpdateProcs
  890.     lappend filesetUpdateProcs($type) [list $proc]
  891. }
  892.  
  893. proc filesetUtilsProc { menu item } {
  894.     global filesetUtils gfileSetsType currFileSet
  895.     if [info exists filesetUtils($item)] {
  896.         # it's a utility
  897.         set utilDesc $filesetUtils($item)
  898.         set allowedTypes [lindex $utilDesc 0]
  899.         if [string match $allowedTypes $gfileSetsType($currFileSet)] {
  900.             return [eval [lindex $utilDesc 1]]
  901.         } else {
  902.             beep
  903.             message "That utility can't be applied to the current file-set."
  904.             return
  905.         }
  906.     } else {
  907.         $item
  908.     }
  909. }
  910. proc getFilesInSet {fset} {
  911.     global gfileSets fileSetsTypesThing gfileSetsType
  912.     switch $fileSetsTypesThing($gfileSetsType($fset)) {
  913.         "list" {
  914.             return $gfileSets($fset)
  915.         }
  916.         "glob" {
  917.             global filesetmodeVars fileSetsExtra
  918.             if $filesetmodeVars(includeNonTextFiles) {
  919.                 set l [glob -nocomplain "$gfileSets($fset)"]
  920.                 if [info exists fileSetsExtra($fset)] {
  921.                     foreach pat $fileSetsExtra($fset) {
  922.                         foreach f [glob -nocomplain [file dirname "$gfileSets($fset)"]:$pat] {
  923.                             set i [lsearch $l $f]
  924.                             set l [lreplace $l $i $i]
  925.                         }
  926.                     }
  927.                 }
  928.                 return $l
  929.             } else {
  930.                 set l [glob -nocomplain -t TEXT "$gfileSets($fset)"]
  931.                 if [info exists fileSetsExtra($fset)] {
  932.                     foreach pat $fileSetsExtra($fset) {
  933.                         foreach f [glob -nocomplain -t TEXT [file dirname "$gfileSets($fset)"]:$pat] {
  934.                             set i [lsearch $l $f]
  935.                             set l [lreplace $l $i $i]
  936.                         }
  937.                     }
  938.                 }
  939.                 return $l
  940.             }
  941.         }
  942.         "procedural" {
  943.             return [$gfileSets($fset)]
  944.         }        
  945.         "default" {
  946.             global fileSets
  947.             if ![info exists fileSets($fset)] {
  948.                 # This means the menu was cached, but this info wasn't.
  949.                 # We calculate the set, and menu, and cache them
  950.                 # (since they're at the end of the file, they over-ride
  951.                 # what's there.
  952.                 
  953.                 # we rebuild the menu too
  954.                 eval [makeFileSetAndMenu $fset 1]
  955.                 cache::add filesetMenuCache "variable" fileSets($fset)
  956.             }
  957.             return $fileSets($fset)
  958.         }
  959.     }
  960. }
  961.  
  962. proc makeFileSetAndMenu {name andMenu {use_cache 0}} {
  963.     if $use_cache {
  964.         set m [cache::snippetRead $name]
  965.         if {$m != ""} {return $m}
  966.     }
  967.     global gfileSetsType fileSetsTypesThing
  968.     message "Building ${name}..."
  969.     set type $gfileSetsType($name)
  970.     switch $fileSetsTypesThing($type) {
  971.         "list" -
  972.         "glob" {
  973.             if $andMenu {
  974.                 set menu {}
  975.                 foreach m [getFilesInSet $name] {
  976.                     lappend menu "[file tail $m]&"
  977.                 }
  978.                 set m [makeFilesetSubMenu $name $name filesetProc [lsort -i $menu]]
  979.             } else {
  980.                 return
  981.             }
  982.         }
  983.         "procedural" {
  984.             return
  985.         }
  986.         "default" {
  987.             set m [${type}MakeFileSetAndMenu $name $andMenu]
  988.             
  989.         }
  990.     }     
  991.     cache::snippetWrite $name $m
  992.     return $m
  993. }
  994.  
  995. proc filesetsSorted { order usedvar {use_cache 0}} {
  996.     upvar $usedvar used
  997.     global filesetmodeVars gfileSets gfileSetsType
  998.     set sets {}
  999.     foreach item $order {
  1000.         switch -- [lindex $item 0] {
  1001.           "-" { 
  1002.               # add divider
  1003.             lappend sets "(-" 
  1004.             continue
  1005.           } 
  1006.           "*" {
  1007.             # add all the rest
  1008.               set subset {}
  1009.             foreach s [array names gfileSets] {
  1010.                 if ![lcontains used $s]  {
  1011.                     lappend subset $s
  1012.                     lappend used $s
  1013.                 }
  1014.             }
  1015.             foreach f [lsort $subset] {
  1016.                 lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1017.             }
  1018.           } 
  1019.           "pattern" {
  1020.               # find all which match a given pattern
  1021.               set patt [lindex $item 1]
  1022.               set subset {}
  1023.             foreach s [array names gfileSets] {
  1024.                 if ![lcontains used $s]  {
  1025.                     if [string match $patt $s] {
  1026.                         lappend subset $s
  1027.                         lappend used $s
  1028.                     }
  1029.                 }
  1030.             }
  1031.             foreach f [lsort $subset] {
  1032.                 lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1033.             }
  1034.               
  1035.           }
  1036.           "submenu" {
  1037.               # add a submenu with name following and sub-order
  1038.               set name [lindex $item 1]
  1039.             set suborder [lrange $item 2 end]              
  1040.               # we make kind of a pretend fileset here.
  1041.               set subsets [filesetsSorted $suborder used]
  1042.               if { $subsets != "" } {
  1043.                   lappend sets [makeFilesetSubMenu $name $name filesetProc $subsets]
  1044.               }
  1045.           }
  1046.           "default" {        
  1047.             set subset {} 
  1048.             foreach s [array names gfileSets] {
  1049.                 if {[lcontains item $gfileSetsType($s)] && ![lcontains used $s]}  {
  1050.                     lappend subset $s
  1051.                     lappend used $s
  1052.                 }
  1053.             }
  1054.             foreach f [lsort $subset] {
  1055.                 lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1056.             }
  1057.           }
  1058.         }
  1059.     
  1060.     }
  1061.     # remove multiple and leading, trailing '-' in case there were gaps
  1062.     regsub -all {\(-( \(-)+} $sets {(-} sets
  1063.     while { [lindex $sets 0] == "(-" } { set sets [lrange $sets 1 end] }
  1064.     set l [expr [llength $sets] -1]
  1065.     if { [lindex $sets $l] == "(-" } { set sets [lrange $sets 0 [incr l -1]] }
  1066.     
  1067.     return $sets
  1068. }
  1069.  
  1070. ## 
  1071.  # -------------------------------------------------------------------------
  1072.  # 
  1073.  # "rebuildFilesetMenu" --
  1074.  # 
  1075.  #  Reads the fileset menu from the cache if it exists.  This speeds up
  1076.  #  start-up by quite a bit.
  1077.  # -------------------------------------------------------------------------
  1078.  ##
  1079. proc rebuildFilesetMenu {} { 
  1080.     message "Building filesets..."
  1081.     if [cache::exists filesetMenuCache] {
  1082.         global subMenuFilesetInfo subMenuInfo fileSets
  1083.         cache::read filesetMenuCache 
  1084.         rebuildFilesetUtilsMenu
  1085.         callFilesetUpdateProcedures
  1086.     } else {
  1087.         rebuildAllFilesets 1
  1088.     }
  1089.     
  1090. }
  1091.     
  1092. ## 
  1093.  # -------------------------------------------------------------------------
  1094.  #     
  1095.  #    "zapAndBuildFilesets" --
  1096.  #    
  1097.  #     This does a complete rebuild of all information.  The problem is that
  1098.  #     the names of menus    may    actually change    (spaces    added/deleted).    This
  1099.  #     is    not    a problem for the fileset menu,    but    is a problem for any
  1100.  #     filesets which    have been added    to other menus,    since they won't know
  1101.  #     that they need    to be rebuilt.
  1102.  # -------------------------------------------------------------------------
  1103.  ##
  1104. proc zapAndBuildFilesets {} {
  1105.     global subMenuInfo subMenuFilesetInfo
  1106.     unset subMenuInfo
  1107.     unset subMenuFilesetInfo
  1108.     rebuildAllFilesets
  1109. }
  1110.  
  1111. proc rebuildAllFilesets { {use_cache 0} } {
  1112.     global gfileSets filesetMenu  filesetSortOrder 
  1113.     global filesetmodeVars filesetsNotInMenu fileSets
  1114.     message "Rebuilding filesets menu…"
  1115.     
  1116.     if $filesetmodeVars(sortFilesetsByType) {
  1117.         # just make file-sets for those we don't want in the menu
  1118.         if {!$use_cache} {
  1119.             foreach f $filesetsNotInMenu {
  1120.                 makeFileSetAndMenu $f 0 
  1121.             }
  1122.         }
  1123.         set used $filesetsNotInMenu
  1124.         set sets [filesetsSorted $filesetSortOrder used $use_cache]
  1125.     } else {
  1126.         foreach f [lsort [array names gfileSets]] {
  1127.             set doMenu [expr ![lcontains filesetsNotInMenu $f]]
  1128.             set menu [makeFileSetAndMenu $f $doMenu $use_cache]
  1129.             if { $doMenu && $menu != "" } {
  1130.                 lappend sets $menu
  1131.             }        
  1132.         }            
  1133.     }
  1134.     
  1135.     regsub -all {[-][nm]} $sets "" names
  1136.     set names [map cadr $names]
  1137.     set names [map "string trimright" $names]
  1138.  
  1139.     # cache the fileset menu
  1140.     set m [list menu -m -n $filesetMenu -p filesetMenuProc \
  1141.         [concat {{/'Edit File…} {menu -n Utilities {}}} "Help" \
  1142.         "(-" $sets]]
  1143.     cache::create filesetMenuCache 
  1144.     cache::add filesetMenuCache "eval" $m [list insertMenu $filesetMenu]
  1145.     global subMenuFilesetInfo subMenuInfo
  1146.     cache::add filesetMenuCache "variable" subMenuFilesetInfo subMenuInfo fileSets
  1147.     eval $m
  1148.        
  1149.     rebuildFilesetUtilsMenu
  1150.     callFilesetUpdateProcedures
  1151.     
  1152.     message ""
  1153. }
  1154.  
  1155. ## 
  1156.  # -------------------------------------------------------------------------
  1157.  #     
  1158.  #    "rebuildSomeFilesetMenu" --
  1159.  #    
  1160.  #     If    given '*' rebuild the entire menu, else    rebuild    only those types
  1161.  #     given.     This is generally useful to avoid excessive rebuilding    when
  1162.  #     flags are adjusted
  1163.  # -------------------------------------------------------------------------
  1164.  ##
  1165. proc rebuildSomeFilesetMenu {args} {
  1166.     rebuildAllFilesets        
  1167. }
  1168.  
  1169. proc rebuildFilesetUtilsMenu {} {
  1170.     global gfileSets filesetUtils 
  1171.  
  1172.     menu -n "Utilities" -p filesetUtilsProc [concat \
  1173.         "newFileset…" \
  1174.         "deleteFileset…" \
  1175.         "<S<EupdateAFileset…" \
  1176.         "<SupdateCurrentFileset" \
  1177.         "<S<EzapAndBuildFilesets" \
  1178.         "<SrebuildAllFilesets" \
  1179.         [list [menu::makeFlagMenu choose list currFileSet]] \
  1180.         [list [list menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]]] \
  1181.         [list [menu::makeFlagMenu filesetFlags array filesetmodeVars]] \
  1182.         "(-" \
  1183.         "/T<I<OfindTag" \
  1184.         "createTagFile" \
  1185.         "(-" \
  1186.         [lsort [array names filesetUtils]] \
  1187.         ]
  1188.    
  1189.     filesetUtilsMarksTicks
  1190. }
  1191.  
  1192. proc rebuildSimpleFilesetMenus {} {
  1193.     global gfileSets fileSetsTypesThing
  1194.     eval [menu::makeFlagMenu choose list currFileSet]
  1195.     menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]
  1196.     filesetUtilsMarksTicks
  1197. }
  1198.  
  1199. proc hideShowFileset {menu item} {
  1200.     global filesetsNotInMenu filesetMenu
  1201.     if [lcontains filesetsNotInMenu $item] {
  1202.         global gfileSetsType
  1203.         if {$gfileSetsType($item) == "procedural"} {
  1204.             alertnote "Sorry, procedural filesets are completely dynamic and cannot appear in menus."
  1205.             return
  1206.         }
  1207.         set idx [lsearch $filesetsNotInMenu $item]
  1208.         set filesetsNotInMenu [lreplace $filesetsNotInMenu $idx $idx]        
  1209.         markMenuItem -m hideFileset $item off
  1210.         # would be better if we could just insert it
  1211.         rebuildAllFilesets 1
  1212.     } else {
  1213.         lappend filesetsNotInMenu $item
  1214.         markMenuItem -m hideFileset $item on
  1215.         if [catch {removeFilesetFromMenu $item}] {
  1216.             rebuildAllFilesets 1
  1217.         }
  1218.     }
  1219.     global modifiedVars
  1220.     lappend modifiedVars filesetsNotInMenu
  1221. }
  1222.  
  1223. proc filesetUtilsMarksTicks {} {
  1224.     global filesetsNotInMenu
  1225.  
  1226.     foreach name $filesetsNotInMenu {
  1227.         markMenuItem -m hideFileset $name on
  1228.     }
  1229.     
  1230. }
  1231.  
  1232.  
  1233. # Called in response to user changing filesets from the fileset menu.
  1234. proc changeFileSet {item} {
  1235.     global currFileSet tagFile
  1236.     # Bring in the tags file for this fileset
  1237.     set fname [tagFileName]
  1238.     if {[file exists $fname]} {
  1239.         if {[dialog::yesno "Use tag file from folder \"$dir\" ?"]} {
  1240.             set tagFile $fname
  1241.         }
  1242.     }
  1243. }
  1244.  
  1245. proc autoUpdateFileset { name } {
  1246.     global currFileSet filesetmodeVars modifiedVars
  1247.     if $filesetmodeVars(autoAdjustFileset) {
  1248.         set currFileSet $name
  1249.         lunion modifiedVars currFileSet
  1250.     }
  1251. }
  1252.  
  1253. #############################################
  1254. #                                            #
  1255. #    Section    5: General Utility procedures    #
  1256. #                                            #
  1257. #############################################
  1258.  
  1259. proc isWindowInFileset { {win "" } {type ""} } {
  1260.     if {$win == ""} { set win [win::Current] }
  1261.     global currFileSet gfileSets gfileSetsType
  1262.  
  1263.     if { $type == "" } {
  1264.         set okSets [array names gfileSets]
  1265.     } else {
  1266.         set okSets {}
  1267.         foreach s [array names gfileSets] {
  1268.             if { $gfileSetsType($s) == $type } {
  1269.                 lappend okSets $s
  1270.             }
  1271.         }
  1272.     }
  1273.     
  1274.     if [array exists gfileSets] {
  1275.         if {[lsearch -exact $okSets $currFileSet] != -1 } {
  1276.             # check current fileset
  1277.             if {[lsearch -exact [getFilesInSet $currFileSet] $win] != -1 } {
  1278.                 # we're set, it's in this fileset
  1279.                 return  $currFileSet
  1280.             }
  1281.         }
  1282.         
  1283.         # check other fileset
  1284.         foreach fset $okSets {
  1285.             if {[lsearch -exact [getFilesInSet $fset] $win] != -1 } {
  1286.                 # we're set, it's in this project
  1287.                 return  $fset
  1288.             }
  1289.         }   
  1290.     }
  1291.     return ""
  1292.     
  1293. }
  1294.  
  1295.  
  1296.  
  1297. ## 
  1298.  # -------------------------------------------------------------------------
  1299.  #     
  1300.  #    "iterateFileset" --
  1301.  # 
  1302.  #       Utility procedure to    iterate    over all files in a    project,
  1303.  #       calling some    predefined function    '$fn' for each member of
  1304.  #       project '$proj'.    The    results    of such    a call are passed to
  1305.  #       '$resfn'    if given. Finally "done" is    passed to 'resfn'.
  1306.  #     
  1307.  # -------------------------------------------------------------------------
  1308.  ##
  1309. proc iterateFileset { proj fn { resfn \# } } {
  1310.     global gfileSets gfileSetsType
  1311.     eval $resfn "first"
  1312.  
  1313.     set check [expr ![catch {$gfileSetsType($proj)IterateCheck check}]]
  1314.     
  1315.     foreach ff [getFileSet $proj] {
  1316.         if { $check && [$gfileSetsType($proj)IterateCheck $proj $ff] } {
  1317.             continue
  1318.         }
  1319.         set res [eval $fn \{$ff\}]
  1320.         eval $resfn \{$res\}
  1321.         
  1322.     }
  1323.     
  1324.     if $check {
  1325.         catch {$gfileSetsType($proj)IterateCheck done}
  1326.     }
  1327.     
  1328.     eval $resfn "done"
  1329.  
  1330. }
  1331.  
  1332. ########################
  1333. #                       #
  1334. #    Section    6:    Tags   #
  1335. #                       #
  1336. ########################
  1337.  
  1338. if ![string length [info commands alphaFindTag]] {
  1339.     rename findTag alphaFindTag
  1340.     rename createTagFile alphaCreateTagFile
  1341. }
  1342.  
  1343. proc tagFileName {} {
  1344.     global gfileSets currFileSet 
  1345.     return [file dirname [car $gfileSets($currFileSet)]]:[join ${currFileSet}]TAGS
  1346. }
  1347.  
  1348. proc findTag {} {
  1349.     global gfileSetsType currFileSet
  1350.     # try a type-specific method first
  1351.     if [catch {$gfileSetsType($currFileSet)FindTag}] {
  1352.         alphaFindTag
  1353.     }
  1354. }
  1355.  
  1356. proc createTagFile {} {
  1357.     global gfileSetsType currFileSet tagFile modifiedVars
  1358.     set tagFile [tagFileName]
  1359.     lappend modifiedVars tagFile
  1360.  
  1361.     # try a type-specific method first
  1362.     if [catch {$gfileSetsType($currFileSet)CreateTagFile}] {
  1363.         alphaCreateTagFile
  1364.     }
  1365. }
  1366.  
  1367.  
  1368. ############################
  1369. #                           #
  1370. #        Section    7: Utils   #
  1371. #                           #
  1372. ############################
  1373.     
  1374.     
  1375. proc dirtyFileset { fset } {
  1376.     foreach f [getFilesInSet $fset] {
  1377.         if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { return 1 }
  1378.     }
  1379.     return 0
  1380. }
  1381.  
  1382. proc saveEntireFileset { fset } {
  1383.     foreach f [getFilesInSet $fset] {
  1384.         if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { 
  1385.             bringToFront $f
  1386.             save 
  1387.         }
  1388.     }
  1389. }
  1390.  
  1391. proc closeEntireFileset { {fset ""} } {
  1392.     set fset [pickFileset $fset "Close which fileset?" "popup"]
  1393.         
  1394.     foreach f [getFilesInSet $fset] {
  1395.         if ![catch {getWinInfo -w $f arr}] {
  1396.             bringToFront $f
  1397.             killWindow
  1398.         }
  1399.     }
  1400. }
  1401.  
  1402. proc fileToAlpha {f} {
  1403.     if {[file isfile $f] && ([getFileType $f] == "TEXT") && ([getFileSig $f] != "ALFA")} {
  1404.         message "Converting $f"
  1405.         setFileInfo $f creator ALFA
  1406.     }    
  1407. }
  1408.  
  1409. proc filesetToAlpha {} {
  1410.     set fset [pickFileset "" {Convert all files from which fileset?} "popup"]
  1411.     iterateFileset $fset fileToAlpha
  1412. }
  1413.  
  1414. ## 
  1415.  # -------------------------------------------------------------------------
  1416.  # 
  1417.  # "replaceInFileset" --
  1418.  # 
  1419.  #  Quotes things correctly so searches work, and adds a check on
  1420.  #  whether there are any windows.
  1421.  # -------------------------------------------------------------------------
  1422.  ##
  1423. proc replaceInFileset {} {
  1424.     global gfileSets win::NumDirty
  1425.     set how [dialog::optionMenu "Search type:" \
  1426.       [list "Textual replace" "Case-independent textual replace" \
  1427.       "Regexp replace" "Case-independent regexp replace"] "" 1]
  1428.     set from [prompt "Search string:" [searchString]]
  1429.     searchString $from
  1430.     if {$how < 2} {set from [quote::Regfind $from]}
  1431.  
  1432.     set to [prompt "Replace string:" [replaceString]]
  1433.     replaceString $to
  1434.     if {$how < 2} {set to [quote::Regsub $to]}
  1435.     if [catch {regsub $from "$from" $to dummy} err] {
  1436.         alertnote "Regexp compilation problems: $err"
  1437.         return
  1438.     }
  1439.     set fsets [pickFileset "" "Which filesets?" "multilist"]
  1440.  
  1441.     if {${win::NumDirty}} {
  1442.         if {[buttonAlert "Save all windows?" "Yes" "Cancel"] != "Yes"} return
  1443.         saveAll
  1444.     }
  1445.  
  1446.     set cid [scancontext create]
  1447.     set changes 0
  1448.     if {$how & 1} {
  1449.         set case "-nocase"
  1450.     } else {
  1451.         set case "--"
  1452.     }
  1453.     
  1454.     scanmatch $case $cid $from {set matches($f) 1 ;incr changes}
  1455.     foreach fset $fsets {
  1456.         foreach f [getFileSet $fset] {
  1457.             if {![catch {set fid [open $f]}]} {
  1458.                 message "Looking at '[file tail $f]'"
  1459.                 scanfile $cid $fid
  1460.                 close $fid
  1461.             }
  1462.         }
  1463.     }
  1464.     
  1465.     scancontext delete $cid
  1466.     
  1467.     foreach f [array names matches] {
  1468.         message "Modifying ${f}…"
  1469.         set cid [open $f "r"]
  1470.         if {[regsub -all $case $from [read $cid] $to out]} {
  1471.             set ocid [open $f "w+"]
  1472.             puts -nonewline $ocid $out
  1473.             close $ocid
  1474.         }
  1475.         close $cid
  1476.     }
  1477.     
  1478.     revertTheseFiles [array names matches]
  1479.     message "Replaced $changes instances"
  1480. }
  1481.  
  1482. proc openEntireFileset {} {
  1483.     set fset [pickFileset "" "Open which fileset?" "popup"]
  1484.     
  1485.     # we use our iterator in case there's something special to do
  1486.     iterateFileset $fset "edit -c -w"
  1487. }
  1488.  
  1489. proc openFilesetFolder {} {
  1490.     global gfileSets
  1491.     set fset [pickFileset "" "Open which fileset's folder?" "popup"]
  1492.     if {[llength $gfileSets($fset)] == 1 && [file isdirectory [set dir [file dirname $gfileSets($fset)]]]} {
  1493.         openFolder $dir
  1494.     } else {
  1495.         alertnote "Fileset not connected to a folder."
  1496.     }
  1497. }
  1498.  
  1499. proc stuffFileset {} {
  1500.     global gfileSetsType gfileSets
  1501.     set fset [pickFileset "" "Which fileset shall I stuff?" "popup"]
  1502.     if [string length $fset] {
  1503.         if { $gfileSetsType($fset) == "fromDirectory" && \
  1504.              [dialog::yesno "Stuff entire directory?"]} {
  1505.              app::launchFore DStf
  1506.              sendOpenEvent reply 'DStf' "[file dirname $gfileSets($fset)]:"
  1507.         } else {            
  1508.             app::launchFore DStf
  1509.             eval sendOpenEvents 'DStf' [getFilesInSet $fset]
  1510.         }        
  1511.         sendQuitEvent 'DStf'
  1512.     }
  1513. }
  1514.  
  1515. proc filesetRememberOpenClose { file } {
  1516.     global fileset_openorclosed
  1517.     set fileset_openorclosed [list "$file" [lsearch -exact [winNames -f] $file]]
  1518. }
  1519.  
  1520. proc filesetRevertOpenClose { file } {
  1521.     global fileset_openorclosed
  1522.     if { [lindex $fileset_openorclosed 0] == "$file" } {
  1523.         if { [lindex $fileset_openorclosed 1] < 0 } {
  1524.             killWindow
  1525.         }
  1526.     }    
  1527.     catch {unset fileset_openorclosed}
  1528. }
  1529.  
  1530. proc wordCountFileset {} {
  1531.   global currFileSet
  1532.   iterateFileset $currFileSet wordCountProc filesetUtilWordCount
  1533. }
  1534.  
  1535. proc wordCountFilesetFast {} {
  1536.   global currFileSet
  1537.   iterateFileset $currFileSet wc filesetUtilWordCount
  1538. }
  1539.  
  1540. proc filesetUtilWordCount {count} {
  1541.     global fs_ccount fs_wcount fs_lcount
  1542.     switch $count {
  1543.         "first" {
  1544.             set fs_ccount 0
  1545.             set fs_wcount 0
  1546.             set fs_lcount 0
  1547.         }       
  1548.         "done" {
  1549.             alertnote "There were $fs_ccount lines, $fs_wcount words and $fs_lcount chars"
  1550.             unset fs_ccount fs_wcount fs_lcount
  1551.         }
  1552.         default {
  1553.             incr fs_ccount [lindex $count 2]
  1554.             incr fs_wcount [lindex $count 1]
  1555.             incr fs_lcount [lindex $count 0]
  1556.         }
  1557.     }
  1558. }
  1559.  
  1560.  
  1561. ## 
  1562.  # -------------------------------------------------------------------------
  1563.  # 
  1564.  # "wordCountProc" --
  1565.  # 
  1566.  #  Completely new proc which does the same as the old one
  1567.  #  without opening lots of windows.
  1568.  #  *Very* memory comsuming for large files, though.
  1569.  #  But I think the old one was equally memeory consuming.
  1570.  #  
  1571.  #  Ok, this is not exactly a bug fix. It's a IMHO better option.
  1572.  #  
  1573.  # -------------------------------------------------------------------------
  1574.  ##
  1575.  
  1576. proc wordCountProc {file} {
  1577.     message "Counting [file tail $file]…"
  1578.     set fid [open $file r]
  1579.     set filecont [read $fid]
  1580.     close $fid
  1581.     if {[regexp {\n\r} $filecont]} {
  1582.         set newln "\n\r"
  1583.     } elseif {[regexp {\n} $filecont]} {
  1584.         set newln "\n"
  1585.     } else {
  1586.         set newln "\r"
  1587.     }
  1588.     set lines [expr [regsub -all $newln $filecont " " filecont] + 1]
  1589.     set chars [string length $filecont]
  1590.     regsub -all {[!=;.,\(\#\=\):\{\"\}]} $filecont " " filecont
  1591.     set words [llength $filecont]
  1592.     return "$chars $words $lines"
  1593. }
  1594.  
  1595.  
  1596. ############################################
  1597. #    Section    2:    Basic fileset procedures   #
  1598. ############################################
  1599.  
  1600.  
  1601. proc findNewFileset {} {
  1602.     return [newFileset]
  1603. }
  1604.  
  1605.  
  1606. proc findNewDirectory {} {
  1607.     global gfileSets currFileSet gfileSetsType gDirScan
  1608.  
  1609.     set dir [string trim [get_directory -p "Scan which folder?"] ":"]
  1610.     if {![string length $dir]} return
  1611.     
  1612.     set filePat {*}
  1613.     set name [file tail $dir]
  1614.     
  1615.     set gfileSets($name) "$dir:$filePat"
  1616.     set gDirScan($name) 1
  1617.     set gfileSetsType($name) "fromDirectory"
  1618.     set currFileSet $name
  1619.     updateCurrentFileset
  1620.     return $name
  1621. }
  1622.  
  1623. # Should be last so all filesets make it in.
  1624. rebuildFilesetMenu
  1625.